home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / perl / perl5a1.lha / perl5alpha1 / bar < prev    next >
Encoding:
Text File  |  1993-07-30  |  1.7 KB  |  67 lines
  1. package bigint;
  2.  
  3. sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
  4.     local (*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
  5.     return wantarray ? ('NaN','NaN') : 'NaN'
  6.     if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
  7.     return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
  8.     @x = &internal($x); @y = &internal($y);
  9.     $srem = $y[$[];
  10.     $sr = (shift @x ne shift @y) ? '-' : '+';
  11.     $car = $bar = $prd = 0;
  12.     if (($dd = int(1e5/($y[$#y]+1))) != 1) {
  13.     for $x (@x) {
  14.         $x = $x * $dd + $car;
  15.         $x -= ($car = int($x * 1e-5)) * 1e5;
  16.     }
  17.     push(@x, $car); $car = 0;
  18.     for $y (@y) {
  19.         $y = $y * $dd + $car;
  20.         $y -= ($car = int($y * 1e-5)) * 1e5;
  21.     }
  22.     }
  23.     else {
  24.     push(@x, 0);
  25.     }
  26.     @q = (); ($v2,$v1) = @y[$#y-1,$#y];
  27.     while ($#x > $#y) {
  28.     ($u2,$u1,$u0) = @x[($#x-2)..$#x];
  29.     $q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
  30.     --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
  31.     if ($q) {
  32.         ($car, $bar) = (0,0);
  33.         for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
  34.         $prd = $q * $y[$y] + $car;
  35.         $prd -= ($car = int($prd * 1e-5)) * 1e5;
  36.         $x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0));
  37.         }
  38.         if ($x[$#x] < $car + $bar) {
  39.         $car = 0; --$q;
  40.         for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
  41.             $x[$x] -= 1e5
  42.             if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
  43.         }
  44.         }   
  45.     }
  46.     pop(@x); unshift(@q, $q);
  47.     }
  48.     if (wantarray) {
  49.     @d = ();
  50.     if ($dd != 1) {
  51.         $car = 0;
  52.         for $x (reverse @x) {
  53.         $prd = $car * 1e5 + $x;
  54.         $car = $prd - ($tmp = int($prd / $dd)) * $dd;
  55.         unshift(@d, $tmp);
  56.         }
  57.     }
  58.     else {
  59.         @d = @x;
  60.     }
  61.     (&external($sr, @q), &external($srem, @d, 0));
  62.     } else {
  63.     &external($sr, @q);
  64.     }
  65. }
  66. 1;
  67.